home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / spinbox.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  14.8 KB  |  575 lines
  1. # spinbox.tcl --
  2. #
  3. # This file defines the default bindings for Tk spinbox widgets and provides
  4. # procedures that help in implementing those bindings.  The spinbox builds
  5. # off the entry widget, so it can reuse Entry bindings and procedures.
  6. #
  7. # RCS: @(#) $Id: spinbox.tcl,v 1.9 2005/07/25 09:06:00 dkf Exp $
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  11. # Copyright (c) 1999-2000 Jeffrey Hobbs
  12. # Copyright (c) 2000 Ajuba Solutions
  13. #
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17.  
  18. #-------------------------------------------------------------------------
  19. # Elements of tk::Priv that are used in this file:
  20. #
  21. # afterId -        If non-null, it means that auto-scanning is underway
  22. #            and it gives the "after" id for the next auto-scan
  23. #            command to be executed.
  24. # mouseMoved -        Non-zero means the mouse has moved a significant
  25. #            amount since the button went down (so, for example,
  26. #            start dragging out a selection).
  27. # pressX -        X-coordinate at which the mouse button was pressed.
  28. # selectMode -        The style of selection currently underway:
  29. #            char, word, or line.
  30. # x, y -        Last known mouse coordinates for scanning
  31. #            and auto-scanning.
  32. # data -        Used for Cut and Copy
  33. #-------------------------------------------------------------------------
  34.  
  35. # Initialize namespace
  36. namespace eval ::tk::spinbox {}
  37.  
  38. #-------------------------------------------------------------------------
  39. # The code below creates the default class bindings for entries.
  40. #-------------------------------------------------------------------------
  41. bind Spinbox <<Cut>> {
  42.     if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
  43.     clipboard clear -displayof %W
  44.     clipboard append -displayof %W $tk::Priv(data)
  45.     %W delete sel.first sel.last
  46.     unset tk::Priv(data)
  47.     }
  48. }
  49. bind Spinbox <<Copy>> {
  50.     if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
  51.     clipboard clear -displayof %W
  52.     clipboard append -displayof %W $tk::Priv(data)
  53.     unset tk::Priv(data)
  54.     }
  55. }
  56. bind Spinbox <<Paste>> {
  57.     global tcl_platform
  58.     catch {
  59.     if {[tk windowingsystem] ne "x11"} {
  60.         catch {
  61.         %W delete sel.first sel.last
  62.         }
  63.     }
  64.     %W insert insert [::tk::GetSelection %W CLIPBOARD]
  65.     ::tk::EntrySeeInsert %W
  66.     }
  67. }
  68. bind Spinbox <<Clear>> {
  69.     %W delete sel.first sel.last
  70. }
  71. bind Spinbox <<PasteSelection>> {
  72.     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  73.     || !$tk::Priv(mouseMoved)} {
  74.     ::tk::spinbox::Paste %W %x
  75.     }
  76. }
  77.  
  78. bind Spinbox <<TraverseIn>> {
  79.     %W selection range 0 end 
  80.     %W icursor end 
  81. }
  82.  
  83. # Standard Motif bindings:
  84.  
  85. bind Spinbox <1> {
  86.     ::tk::spinbox::ButtonDown %W %x %y
  87. }
  88. bind Spinbox <B1-Motion> {
  89.     ::tk::spinbox::Motion %W %x %y
  90. }
  91. bind Spinbox <Double-1> {
  92.     set tk::Priv(selectMode) word
  93.     ::tk::spinbox::MouseSelect %W %x sel.first
  94. }
  95. bind Spinbox <Triple-1> {
  96.     set tk::Priv(selectMode) line
  97.     ::tk::spinbox::MouseSelect %W %x 0
  98. }
  99. bind Spinbox <Shift-1> {
  100.     set tk::Priv(selectMode) char
  101.     %W selection adjust @%x
  102. }
  103. bind Spinbox <Double-Shift-1> {
  104.     set tk::Priv(selectMode) word
  105.     ::tk::spinbox::MouseSelect %W %x
  106. }
  107. bind Spinbox <Triple-Shift-1> {
  108.     set tk::Priv(selectMode) line
  109.     ::tk::spinbox::MouseSelect %W %x
  110. }
  111. bind Spinbox <B1-Leave> {
  112.     set tk::Priv(x) %x
  113.     ::tk::spinbox::AutoScan %W
  114. }
  115. bind Spinbox <B1-Enter> {
  116.     tk::CancelRepeat
  117. }
  118. bind Spinbox <ButtonRelease-1> {
  119.     ::tk::spinbox::ButtonUp %W %x %y
  120. }
  121. bind Spinbox <Control-1> {
  122.     %W icursor @%x
  123. }
  124.  
  125. bind Spinbox <Up> {
  126.     %W invoke buttonup
  127. }
  128. bind Spinbox <Down> {
  129.     %W invoke buttondown
  130. }
  131.  
  132. bind Spinbox <Left> {
  133.     ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  134. }
  135. bind Spinbox <Right> {
  136.     ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  137. }
  138. bind Spinbox <Shift-Left> {
  139.     ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
  140.     ::tk::EntrySeeInsert %W
  141. }
  142. bind Spinbox <Shift-Right> {
  143.     ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
  144.     ::tk::EntrySeeInsert %W
  145. }
  146. bind Spinbox <Control-Left> {
  147.     ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
  148. }
  149. bind Spinbox <Control-Right> {
  150.     ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
  151. }
  152. bind Spinbox <Shift-Control-Left> {
  153.     ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]
  154.     ::tk::EntrySeeInsert %W
  155. }
  156. bind Spinbox <Shift-Control-Right> {
  157.     ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]
  158.     ::tk::EntrySeeInsert %W
  159. }
  160. bind Spinbox <Home> {
  161.     ::tk::EntrySetCursor %W 0
  162. }
  163. bind Spinbox <Shift-Home> {
  164.     ::tk::EntryKeySelect %W 0
  165.     ::tk::EntrySeeInsert %W
  166. }
  167. bind Spinbox <End> {
  168.     ::tk::EntrySetCursor %W end
  169. }
  170. bind Spinbox <Shift-End> {
  171.     ::tk::EntryKeySelect %W end
  172.     ::tk::EntrySeeInsert %W
  173. }
  174.  
  175. bind Spinbox <Delete> {
  176.     if {[%W selection present]} {
  177.     %W delete sel.first sel.last
  178.     } else {
  179.     %W delete insert
  180.     }
  181. }
  182. bind Spinbox <BackSpace> {
  183.     ::tk::EntryBackspace %W
  184. }
  185.  
  186. bind Spinbox <Control-space> {
  187.     %W selection from insert
  188. }
  189. bind Spinbox <Select> {
  190.     %W selection from insert
  191. }
  192. bind Spinbox <Control-Shift-space> {
  193.     %W selection adjust insert
  194. }
  195. bind Spinbox <Shift-Select> {
  196.     %W selection adjust insert
  197. }
  198. bind Spinbox <Control-slash> {
  199.     %W selection range 0 end
  200. }
  201. bind Spinbox <Control-backslash> {
  202.     %W selection clear
  203. }
  204. bind Spinbox <KeyPress> {
  205.     ::tk::EntryInsert %W %A
  206. }
  207.  
  208. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  209. # Otherwise, if a widget binding for one of these is defined, the
  210. # <KeyPress> class binding will also fire and insert the character,
  211. # which is wrong.  Ditto for Escape, Return, and Tab.
  212.  
  213. bind Spinbox <Alt-KeyPress> {# nothing}
  214. bind Spinbox <Meta-KeyPress> {# nothing}
  215. bind Spinbox <Control-KeyPress> {# nothing}
  216. bind Spinbox <Escape> {# nothing}
  217. bind Spinbox <Return> {# nothing}
  218. bind Spinbox <KP_Enter> {# nothing}
  219. bind Spinbox <Tab> {# nothing}
  220. if {[tk windowingsystem] eq "aqua"} {
  221.     bind Spinbox <Command-KeyPress> {# nothing}
  222. }
  223.  
  224. # On Windows, paste is done using Shift-Insert.  Shift-Insert already
  225. # generates the <<Paste>> event, so we don't need to do anything here.
  226. if {$tcl_platform(platform) ne "windows"} {
  227.     bind Spinbox <Insert> {
  228.     catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
  229.     }
  230. }
  231.  
  232. # Additional emacs-like bindings:
  233.  
  234. bind Spinbox <Control-a> {
  235.     if {!$tk_strictMotif} {
  236.     ::tk::EntrySetCursor %W 0
  237.     }
  238. }
  239. bind Spinbox <Control-b> {
  240.     if {!$tk_strictMotif} {
  241.     ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  242.     }
  243. }
  244. bind Spinbox <Control-d> {
  245.     if {!$tk_strictMotif} {
  246.     %W delete insert
  247.     }
  248. }
  249. bind Spinbox <Control-e> {
  250.     if {!$tk_strictMotif} {
  251.     ::tk::EntrySetCursor %W end
  252.     }
  253. }
  254. bind Spinbox <Control-f> {
  255.     if {!$tk_strictMotif} {
  256.     ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  257.     }
  258. }
  259. bind Spinbox <Control-h> {
  260.     if {!$tk_strictMotif} {
  261.     ::tk::EntryBackspace %W
  262.     }
  263. }
  264. bind Spinbox <Control-k> {
  265.     if {!$tk_strictMotif} {
  266.     %W delete insert end
  267.     }
  268. }
  269. bind Spinbox <Control-t> {
  270.     if {!$tk_strictMotif} {
  271.     ::tk::EntryTranspose %W
  272.     }
  273. }
  274. bind Spinbox <Meta-b> {
  275.     if {!$tk_strictMotif} {
  276.     ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
  277.     }
  278. }
  279. bind Spinbox <Meta-d> {
  280.     if {!$tk_strictMotif} {
  281.     %W delete insert [::tk::EntryNextWord %W insert]
  282.     }
  283. }
  284. bind Spinbox <Meta-f> {
  285.     if {!$tk_strictMotif} {
  286.     ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
  287.     }
  288. }
  289. bind Spinbox <Meta-BackSpace> {
  290.     if {!$tk_strictMotif} {
  291.     %W delete [::tk::EntryPreviousWord %W insert] insert
  292.     }
  293. }
  294. bind Spinbox <Meta-Delete> {
  295.     if {!$tk_strictMotif} {
  296.     %W delete [::tk::EntryPreviousWord %W insert] insert
  297.     }
  298. }
  299.  
  300. # A few additional bindings of my own.
  301.  
  302. bind Spinbox <2> {
  303.     if {!$tk_strictMotif} {
  304.     ::tk::EntryScanMark %W %x
  305.     }
  306. }
  307. bind Spinbox <B2-Motion> {
  308.     if {!$tk_strictMotif} {
  309.     ::tk::EntryScanDrag %W %x
  310.     }
  311. }
  312.  
  313. # ::tk::spinbox::Invoke --
  314. # Invoke an element of the spinbox
  315. #
  316. # Arguments:
  317. # w -        The spinbox window.
  318. # elem -    Element to invoke
  319.  
  320. proc ::tk::spinbox::Invoke {w elem} {
  321.     variable ::tk::Priv
  322.  
  323.     if {![info exists Priv(outsideElement)]} {
  324.     $w invoke $elem
  325.     incr Priv(repeated)
  326.     }
  327.     set delay [$w cget -repeatinterval]
  328.     if {$delay > 0} {
  329.     set Priv(afterId) [after $delay \
  330.         [list ::tk::spinbox::Invoke $w $elem]]
  331.     }
  332. }
  333.  
  334. # ::tk::spinbox::ClosestGap --
  335. # Given x and y coordinates, this procedure finds the closest boundary
  336. # between characters to the given coordinates and returns the index
  337. # of the character just after the boundary.
  338. #
  339. # Arguments:
  340. # w -        The spinbox window.
  341. # x -        X-coordinate within the window.
  342.  
  343. proc ::tk::spinbox::ClosestGap {w x} {
  344.     set pos [$w index @$x]
  345.     set bbox [$w bbox $pos]
  346.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  347.     return $pos
  348.     }
  349.     incr pos
  350. }
  351.  
  352. # ::tk::spinbox::ButtonDown --
  353. # This procedure is invoked to handle button-1 presses in spinbox
  354. # widgets.  It moves the insertion cursor, sets the selection anchor,
  355. # and claims the input focus.
  356. #
  357. # Arguments:
  358. # w -        The spinbox window in which the button was pressed.
  359. # x -        The x-coordinate of the button press.
  360.  
  361. proc ::tk::spinbox::ButtonDown {w x y} {
  362.     variable ::tk::Priv
  363.  
  364.     # Get the element that was clicked in.  If we are not directly over
  365.     # the spinbox, default to entry.  This is necessary for spinbox grabs.
  366.     #
  367.     set Priv(element) [$w identify $x $y]
  368.     if {$Priv(element) eq ""} {
  369.     set Priv(element) "entry"
  370.     }
  371.  
  372.     switch -exact $Priv(element) {
  373.     "buttonup" - "buttondown" {
  374.         if {"disabled" ne [$w cget -state]} {
  375.         $w selection element $Priv(element)
  376.         set Priv(repeated) 0
  377.         set Priv(relief) [$w cget -$Priv(element)relief]
  378.         catch {after cancel $Priv(afterId)}
  379.         set delay [$w cget -repeatdelay]
  380.         if {$delay > 0} {
  381.             set Priv(afterId) [after $delay \
  382.                 [list ::tk::spinbox::Invoke $w $Priv(element)]]
  383.         }
  384.         if {[info exists Priv(outsideElement)]} {
  385.             unset Priv(outsideElement)
  386.         }
  387.         }
  388.     }
  389.     "entry" {
  390.         set Priv(selectMode) char
  391.         set Priv(mouseMoved) 0
  392.         set Priv(pressX) $x
  393.         $w icursor [::tk::spinbox::ClosestGap $w $x]
  394.         $w selection from insert
  395.         if {"disabled" ne [$w cget -state]} {focus $w}
  396.         $w selection clear
  397.     }
  398.     default {
  399.         return -code error "unknown spinbox element \"$Priv(element)\""
  400.     }
  401.     }
  402. }
  403.  
  404. # ::tk::spinbox::ButtonUp --
  405. # This procedure is invoked to handle button-1 releases in spinbox
  406. # widgets.
  407. #
  408. # Arguments:
  409. # w -        The spinbox window in which the button was pressed.
  410. # x -        The x-coordinate of the button press.
  411.  
  412. proc ::tk::spinbox::ButtonUp {w x y} {
  413.     variable ::tk::Priv
  414.  
  415.     ::tk::CancelRepeat
  416.  
  417.     # Priv(relief) may not exist if the ButtonUp is not paired with
  418.     # a preceding ButtonDown
  419.     if {[info exists Priv(element)] && [info exists Priv(relief)] && \
  420.         [string match "button*" $Priv(element)]} {
  421.     if {[info exists Priv(repeated)] && !$Priv(repeated)} {
  422.         $w invoke $Priv(element)
  423.     }
  424.     $w configure -$Priv(element)relief $Priv(relief)
  425.     $w selection element none
  426.     }
  427. }
  428.  
  429. # ::tk::spinbox::MouseSelect --
  430. # This procedure is invoked when dragging out a selection with
  431. # the mouse.  Depending on the selection mode (character, word,
  432. # line) it selects in different-sized units.  This procedure
  433. # ignores mouse motions initially until the mouse has moved from
  434. # one character to another or until there have been multiple clicks.
  435. #
  436. # Arguments:
  437. # w -        The spinbox window in which the button was pressed.
  438. # x -        The x-coordinate of the mouse.
  439. # cursor -    optional place to set cursor.
  440.  
  441. proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {
  442.     variable ::tk::Priv
  443.  
  444.     if {$Priv(element) ne "entry"} {
  445.     # The ButtonUp command triggered by ButtonRelease-1 handles
  446.     # invoking one of the spinbuttons.
  447.     return
  448.     }
  449.     set cur [::tk::spinbox::ClosestGap $w $x]
  450.     set anchor [$w index anchor]
  451.     if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  452.     set Priv(mouseMoved) 1
  453.     }
  454.     switch $Priv(selectMode) {
  455.     char {
  456.         if {$Priv(mouseMoved)} {
  457.         if {$cur < $anchor} {
  458.             $w selection range $cur $anchor
  459.         } elseif {$cur > $anchor} {
  460.             $w selection range $anchor $cur
  461.         } else {
  462.             $w selection clear
  463.         }
  464.         }
  465.     }
  466.     word {
  467.         if {$cur < [$w index anchor]} {
  468.         set before [tcl_wordBreakBefore [$w get] $cur]
  469.         set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
  470.         } else {
  471.         set before [tcl_wordBreakBefore [$w get] $anchor]
  472.         set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
  473.         }
  474.         if {$before < 0} {
  475.         set before 0
  476.         }
  477.         if {$after < 0} {
  478.         set after end
  479.         }
  480.         $w selection range $before $after
  481.     }
  482.     line {
  483.         $w selection range 0 end
  484.     }
  485.     }
  486.     if {$cursor ne {} && $cursor ne "ignore"} {
  487.     catch {$w icursor $cursor}
  488.     }
  489.     update idletasks
  490. }
  491.  
  492. # ::tk::spinbox::Paste --
  493. # This procedure sets the insertion cursor to the current mouse position,
  494. # pastes the selection there, and sets the focus to the window.
  495. #
  496. # Arguments:
  497. # w -        The spinbox window.
  498. # x -        X position of the mouse.
  499.  
  500. proc ::tk::spinbox::Paste {w x} {
  501.     $w icursor [::tk::spinbox::ClosestGap $w $x]
  502.     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
  503.     if {"disabled" eq [$w cget -state]} {
  504.     focus $w
  505.     }
  506. }
  507.  
  508. # ::tk::spinbox::Motion --
  509. # This procedure is invoked when the mouse moves in a spinbox window
  510. # with button 1 down.
  511. #
  512. # Arguments:
  513. # w -        The spinbox window.
  514.  
  515. proc ::tk::spinbox::Motion {w x y} {
  516.     variable ::tk::Priv
  517.  
  518.     if {![info exists Priv(element)]} {
  519.     set Priv(element) [$w identify $x $y]
  520.     }
  521.  
  522.     set Priv(x) $x
  523.     if {"entry" eq $Priv(element)} {
  524.     ::tk::spinbox::MouseSelect $w $x ignore
  525.     } elseif {[$w identify $x $y] ne $Priv(element)} {
  526.     if {![info exists Priv(outsideElement)]} {
  527.         # We've wandered out of the spin button
  528.         # setting outside element will cause ::tk::spinbox::Invoke to
  529.         # loop without doing anything
  530.         set Priv(outsideElement) ""
  531.         $w selection element none
  532.     }
  533.     } elseif {[info exists Priv(outsideElement)]} {
  534.     unset Priv(outsideElement)
  535.     $w selection element $Priv(element)
  536.     }
  537. }
  538.  
  539. # ::tk::spinbox::AutoScan --
  540. # This procedure is invoked when the mouse leaves an spinbox window
  541. # with button 1 down.  It scrolls the window left or right,
  542. # depending on where the mouse is, and reschedules itself as an
  543. # "after" command so that the window continues to scroll until the
  544. # mouse moves back into the window or the mouse button is released.
  545. #
  546. # Arguments:
  547. # w -        The spinbox window.
  548.  
  549. proc ::tk::spinbox::AutoScan {w} {
  550.     variable ::tk::Priv
  551.  
  552.     set x $Priv(x)
  553.     if {$x >= [winfo width $w]} {
  554.     $w xview scroll 2 units
  555.     ::tk::spinbox::MouseSelect $w $x ignore
  556.     } elseif {$x < 0} {
  557.     $w xview scroll -2 units
  558.     ::tk::spinbox::MouseSelect $w $x ignore
  559.     }
  560.     set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
  561. }
  562.  
  563. # ::tk::spinbox::GetSelection --
  564. #
  565. # Returns the selected text of the spinbox.  Differs from entry in that
  566. # a spinbox has no -show option to obscure contents.
  567. #
  568. # Arguments:
  569. # w -         The spinbox window from which the text to get
  570.  
  571. proc ::tk::spinbox::GetSelection {w} {
  572.     return [string range [$w get] [$w index sel.first] \
  573.         [expr {[$w index sel.last] - 1}]]
  574. }
  575.